home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mquery / mfilter.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-02  |  7.9 KB  |  259 lines
  1. VERSION 2.00
  2. Begin Form fFilter 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Filter"
  6.    ClientHeight    =   2370
  7.    ClientLeft      =   3390
  8.    ClientTop       =   3675
  9.    ClientWidth     =   5070
  10.    ControlBox      =   0   'False
  11.    Height          =   2775
  12.    Left            =   3330
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    ScaleHeight     =   2412
  17.    ScaleMode       =   0  'User
  18.    ScaleWidth      =   5160
  19.    Top             =   3330
  20.    Width           =   5190
  21.    Begin ListBox cFieldList 
  22.       BackColor       =   &H00FFFFFF&
  23.       Height          =   1395
  24.       Left            =   240
  25.       TabIndex        =   2
  26.       Tag             =   " OL"
  27.       Top             =   360
  28.       Width           =   1695
  29.    End
  30.    Begin ListBox cOpsList 
  31.       BackColor       =   &H00FFFFFF&
  32.       Height          =   1395
  33.       Left            =   2040
  34.       TabIndex        =   7
  35.       Tag             =   " OL"
  36.       Top             =   360
  37.       Width           =   960
  38.    End
  39.    Begin TextBox cExpr 
  40.       BackColor       =   &H00FFFFFF&
  41.       Height          =   287
  42.       Left            =   3120
  43.       TabIndex        =   1
  44.       Tag             =   " OL"
  45.       Top             =   360
  46.       Width           =   1811
  47.    End
  48.    Begin CommandButton OkayButton 
  49.       Caption         =   "&OK"
  50.       Default         =   -1  'True
  51.       Enabled         =   0   'False
  52.       Height          =   372
  53.       Left            =   600
  54.       TabIndex        =   4
  55.       Top             =   1919
  56.       Width           =   1691
  57.    End
  58.    Begin CommandButton CancelButton 
  59.       Cancel          =   -1  'True
  60.       Caption         =   "&Cancel"
  61.       Height          =   372
  62.       Left            =   2879
  63.       TabIndex        =   5
  64.       Top             =   1919
  65.       Width           =   1691
  66.    End
  67.    Begin Label Label1 
  68.       Alignment       =   2  'Center
  69.       AutoSize        =   -1  'True
  70.       BackColor       =   &H00C0C0C0&
  71.       Caption         =   "Do not use quotes"
  72.       Height          =   195
  73.       Left            =   3195
  74.       TabIndex        =   8
  75.       Top             =   720
  76.       Width           =   1605
  77.    End
  78.    Begin Label OpsLabel 
  79.       BackColor       =   &H00C0C0C0&
  80.       Caption         =   "Operators:"
  81.       Height          =   192
  82.       Left            =   2039
  83.       TabIndex        =   6
  84.       Top             =   120
  85.       Width           =   971
  86.    End
  87.    Begin Label FieldListLabel 
  88.       BackColor       =   &H00C0C0C0&
  89.       Caption         =   "Fields:"
  90.       Height          =   192
  91.       Left            =   240
  92.       TabIndex        =   3
  93.       Top             =   120
  94.       Width           =   1092
  95.    End
  96.    Begin Label ExprLabel 
  97.       BackColor       =   &H00C0C0C0&
  98.       Caption         =   "Value or Expression:"
  99.       Height          =   192
  100.       Left            =   3120
  101.       TabIndex        =   0
  102.       Top             =   120
  103.       Width           =   1811
  104.    End
  105. Option Explicit
  106. Dim FNotFound As Integer
  107. Sub CancelButton_Click ()
  108.   Hide
  109.   'set the flag for the dynaset/dynagrid form
  110.   gfFindFailed = True
  111. End Sub
  112. Sub cExpr_Change ()
  113.   If cFieldList <> "" And cOpsList <> "" And cExpr <> "" Then
  114.     OkayButton.Enabled = True
  115.   Else
  116.     OkayButton.Enabled = False
  117.   End If
  118. End Sub
  119. Sub cExpr_KeyPress (keyascii As Integer)
  120. If keyascii = 34 Then
  121. keyascii = 0
  122. End If
  123. End Sub
  124. Sub cFieldList_Click ()
  125.   If cFieldList <> "" And cOpsList <> "" And cExpr <> "" Then
  126.     OkayButton.Enabled = True
  127.   Else
  128.     OkayButton.Enabled = False
  129.   End If
  130. End Sub
  131. Sub cOpsList_Click ()
  132.   If cFieldList <> "" And cOpsList <> "" And cExpr <> "" Then
  133.     OkayButton.Enabled = True
  134.   Else
  135.     OkayButton.Enabled = False
  136.   End If
  137. End Sub
  138. Sub Form_Load ()
  139.    Me.Left = (screen.Width - Me.Width) / 2
  140.    Me.Top = (screen.Height - Me.Height) / 2
  141.   FNotFound = False
  142.   cOpsList.AddItem "="
  143.   cOpsList.AddItem "<>"
  144.   cOpsList.AddItem ">="
  145.   cOpsList.AddItem "<="
  146.   cOpsList.AddItem ">"
  147.   cOpsList.AddItem "<"
  148.   cOpsList.AddItem "Like"
  149. End Sub
  150. Sub Form_Paint ()
  151.   Outlines Me
  152. End Sub
  153. Sub OkayButton_Click ()
  154.    Dim i As Integer
  155.    Dim isit As Variant ' checking for dates and numbers
  156.    Dim j As Integer
  157.    Dim k As Integer
  158.    Dim TableStr() As String ' stores multiple table names
  159.    Dim l As Integer
  160.    Dim addFltr As String ' adds proper table name to filter
  161.    On Error GoTo FindErr
  162.    FNotFound = False
  163.    SetHourGlass Me
  164.    gstFindField = cFieldList
  165.    gstFindExpr = cExpr
  166.    gstFindOp = cOpsList
  167.   ' add table name to field for proper sql statement
  168.   ' get tables, may be a few
  169.   i = InStr(1, gTblname, ",")
  170.     If i = Len(gTblname) Then  ' last can end with a comma
  171.         gTblname = Left(gTblname, i - 1)
  172.         Exit Do
  173.     End If
  174.        If i > 0 Then  ' if a comma then 1 to comma-1 is first table
  175.            ' take first table
  176.            ReDim Preserve TableStr(j)
  177.            TableStr(j) = Left(gTblname, i - 1) & "."
  178.            ' strip TableStr(j) from gTblName
  179.            gTblname = Mid(gTblname, i + 1, Len(gTblname))
  180.            j = j + 1 ' increment counter
  181.        End If
  182.   Loop Until i = 0
  183.   ' get last table if more than one cause above code doesn't
  184.   If j > 0 Then
  185.     ReDim Preserve TableStr(j)
  186.     TableStr(j) = gTblname & "."
  187.     gTblname = ""
  188.   End If
  189.     Select Case gTblname
  190.         Case Is = ""' multiple tables
  191.         For l = 0 To j
  192.         For i = 1 To Len(gstDynaString)
  193.            If k > 1 Then Exit For
  194.             k = InStr(i, UCase(gstDynaString), UCase(TableStr(l) & "[" & gstFindField & "]"))
  195.              If k > 1 Then
  196.                  addFltr = TableStr(l)
  197.                  Exit For
  198.                  End If
  199.        Next i
  200.        Next l
  201.     Case Else  'single table
  202.        addFltr = Trim(gTblname & ".")
  203.     End Select
  204.    isit = cExpr
  205.    'see if it's a date field
  206.         If IsDate(isit) Then
  207.         i = InStr(1, gstFindField, " ")
  208.            If i > 0 Then
  209.             gFilterStr = "[" + gstFindField + "]" + " " + gstFindOp + " " + "#" + gstFindExpr + "#"
  210.            Else
  211.             gFilterStr = gstFindField + " " + gstFindOp + " " + "#" + gstFindExpr + "#"
  212.            End If
  213.         Hide
  214.         GoTo Findend
  215.         'Stop'
  216.         End If
  217.    If IsNumeric(isit) Then
  218.    ' pass it, it's a number but put quotes around field name
  219.         i = InStr(1, gstFindField, " ")
  220.            If i > 0 Then
  221.             gFilterStr = "[" + gstFindField + "]" + " " + gstFindOp + " " + gstFindExpr
  222.            Else
  223.             gFilterStr = gstFindField + " " + gstFindOp + " " + gstFindExpr
  224.            End If
  225.    Else
  226.    ' put brackets around expression
  227.        ' i = InStr(1, gstFindField, " ")
  228.            'If i > 0 Then
  229.             gFilterStr = "[" + gstFindField + "]" + " " + gstFindOp + " " + Chr(34) + gstFindExpr + Chr(34)
  230.            'Else
  231.             'gFilterStr = gstFindField + " " + gstFindOp + " " + Chr(34) + gstFindExpr + Chr(34)
  232.            'End If
  233.   End If
  234.    gFilterStr = addFltr + gFilterStr
  235. ' see if this was not a stored query..if not add to SQL statement for save
  236.  If Not gStoredFlag Then
  237.     i = InStr(1, UCase(gstDynaString), "WHERE") 'see if a where exists
  238.         If i = 0 Then
  239.             gstDynaString = Trim(gstDynaString & " Where " & "(" & gFilterStr & ")")
  240.         Else
  241.             k = InStr(i + 5, gstDynaString, ")")
  242.             addFltr = Mid(gstDynaString, k + 1, Len(gstDynaString)) ' more at end?
  243.             gstDynaString = Trim(Mid(gstDynaString, 1, k - 1) & " And " & gFilterStr & ")" & " " & addFltr)
  244.         End If
  245.  End If
  246.    Hide
  247.    GoTo Findend
  248. FindErr:
  249.    If Err <> EOF_ERR Then
  250.      ShowError
  251.      Resume Findend
  252.    Else
  253.      FNotFound = True
  254.      Resume Next
  255.    End If
  256. Findend:
  257.    ResetMouse Me
  258. End Sub
  259.